﻿/// /////////////////////////////////////////////
// 单元名 : unitObjBase
// 作者 : Hawk
// 单元描述 : 服务对象基类
// 日期 : 2023-09-15
/// /////////////////////////////////////////////

{$IFDEF FPC}
{$H+}
{$MODE DELPHI}
{$ENDIF}
unit unitObjBase;

interface

uses {$IFDEF MSWINDOWS}Windows,{$ENDIF} SyncObjs, unitCommonTypes, unitDDLinkList, unitCommonDataStruct, unitMsgObj, DateUtils,
  unitObjPool, unitAAACommon, unitDebugObj, unitCommonClasses, unitIndexTable, unitDataCenter, unitLogCommon, unitNetCommon;

const
  I_OBJCOUNT_PERLEVEL = 254;
  S_INIT = 'Init';

type
  TSendMsgToObj = procedure(const Tgt, Peer: TID_OBJ; MsgID: longword; Data: longword = 0;
    Pram: TSerialObj = nil) of object;
  TMsgProcessProc = procedure(msg: TMsg) of object;
  TExecThread = class;
  TObjRoot = class;

  TObjBase = class(TDoubleDirLinkListItem)
  private
    FObjIdx: byte;
    FOnlyLocalDbg: Boolean;

    function GetModuleID: TID_MODULE;
    function GetFullObjID: TID_OBJ;
    procedure ProcUserNotify(msg: TMsg);
  protected
    function HostIsMe(const hid: TID_HOST): boolean; virtual;
    function DoGetHostID: TID_HOST; virtual;
    function DoProcessMsg(msg: TMsg): boolean; virtual;
    procedure DoCorrectObjID(Obj: TObjBase; LastIdx, NewIdx: byte); virtual;
    procedure DoDumpObj; override;

    function ObjRoot: TObjRoot;
    function LocalRootID: TID_OBJ;
    procedure MajorBroadcast(const src: TID_OBJ; MsgID: longword; Param: TSerialObj = nil);
    procedure SendLog(const UID: TID_OBJ; LogID, LogLevel: longword; Param: TCommStrArr);
    procedure AddHostFunc(const fID: TID_OBJ; fName, InitValue, Comment: CommonString; ValueType: TValueType);
    procedure SetHostParam(const ParamID: TID_OBJ; Value: CommonString);
    procedure InitResource(const rid, accmask: TID_OBJ; Flag: longword; Comment: CommonString);
    procedure ClearPrioritys(const rid: TID_OBJ);
    procedure InitPriority(const rid, accid: TID_OBJ; Comment: CommonString; Mask: longword);
    procedure InitPriorityLocalModule(const rid: TID_OBJ; Comment: CommonString);
    procedure InitPriorityAllOpe(const rid, accid: TID_OBJ; Comment: CommonString); // 增加所有权限
    procedure DelPriority(const rid, accid: TID_OBJ); // 增加所有权限
    procedure StartOrStopHostFunc(const hid: TID_HOST; const id: TID_OBJ; start: boolean);
    procedure FocusResource(const hid: TID_HOST; const rIDs: TObjIDArr);
    procedure NotifyFocus(const id: TID_OBJ; notifyMsg: TMsg);
    procedure NotifyRecordUpdated(rIDs: TObjIDArr);
  public
    procedure Return; override;

    function FindObj(Idx: byte): TObjBase; virtual;
    function GetAMsg(RequestMsg: TMsg = nil): TMsg;
    procedure AddObj(Obj: TObjBase);
    procedure DelObj(Obj: TObjBase);
    procedure SendMsg(m: TMsg);
    procedure SendMsgToObj(const Tgt, objid: TID_OBJ; MsgID: longword; Data: longword = 0;
      Pram: TSerialObj = nil; Err: longword = 0); overload;
    procedure SendMsgToObj(const Tgt: TID_OBJ; MsgID: longword; Data: longword = 0;
      Pram: TSerialObj = nil; Err: longword = 0); overload;
    procedure SendMsgToObj(const Tgt: TID_OBJ; MsgID: longword; Prams: array of TSerialObj;
      Data: longword = 0; Err: longword = 0); overload;
    procedure SendMsgToSelf(MsgID: longword; const tblid, pntid: TID_OBJ; Prams: array of TSerialObj;
      Data: longword = 0; Err: longword = 0); overload;
    procedure ReturnMsg(src: TMsg; MsgID: longword; Param: TSerialObj = nil; Data: longword = 0; Err: ERRCODE = 0);
    procedure ReturnMsg1(src: TMsg; MsgID: longword; Param: TSerialObj = nil; Data: longword = 0; Obj: TObject = nil);
    procedure ReturnMsg2(src: TMsg; MsgID: longword; const tblid, pntid: TID_OBJ;
      params: array of TSerialObj; Data: longword = 0; Err: ERRCODE = 0);
    procedure ReturnList(src: TMsg; mesID: longword; list: TSerialObj);
    procedure SetProperty(PropertyName, PropertyValue: CommonString); virtual;
    procedure GetObj(const hid: TID_HOST; const id: TID_OBJ; NeedSubObjs: boolean = True; FocusObjs: boolean = True);
    procedure GetRecord(const oid: TID_OBJ);
    procedure AddRecord(const pntid: TID_OBJ; Obj: TSerialObj);
    procedure DelRecord(const objid: TID_OBJ);
    procedure Dbg(FmtStr: CommonString; Param: array of const; DbgLvl: longword = L_DBGLEVEL_DEBUG); overload;
    procedure Dbg(Str: CommonString; DbgLvl: longword = L_DBGLEVEL_DEBUG); overload;

    property ObjIdx: byte read FObjIdx;
    property OnlyLocalDbg: Boolean read FOnlyLocalDbg write FOnlyLocalDbg;
    property ModuleID: TID_MODULE read GetModuleID;
    property FullObjID: TID_OBJ read GetFullObjID;
  end;

  TObjClass = class of TObjBase;

  TFastObjBase = class(TObjBase)
  private
    FQuickObjIndex: array [1 .. I_OBJCOUNT_PERLEVEL] of TObjBase;

    procedure Init;
  protected
    procedure AppendItem(DDLLI: TDoubleDirLinkListItem; Debug: boolean = False); override;
    procedure DeleteItem(DDLLI: TDoubleDirLinkListItem; FreeItem: boolean = True; Debug: boolean = False); override;
    procedure ClearItems(FreeItem: boolean = True); override;
    procedure DoCorrectObjID(Obj: TObjBase; LastIdx, NewIdx: byte); override;
  public
    procedure Return; override;

    function FindObj(Idx: byte): TObjBase; override;
  end;

  TMajorObjStatus = (mosIdle, mosInit1, mosNormal, mosError, mosStoping, mosWaitFree, mosStoped);

  TMajorObjBase = class(TFastObjBase)
  private
    FBindExecThread: TExecThread;
    FObjTree: TDataCenter;
    FAAAQuery: TAAAQueryProcObj;
    FProcessedMsgCount: longword;
    FUnHandledExceptCount: longword;
    FMajorObjStatus: TMajorObjStatus;
    procedure ExecuteMsg(ExecObj: TObjBase; msg: TMsg);
    procedure MessageProcessCompleted(msg: TMsg);
  protected
    function DoProcessMsg(msg: TMsg): boolean; override;
    function UserIDOfSource(const eid: TID_OBJ): TID_OBJ; overload;
    function UserIDOfSource(const msg: TMsg): TID_OBJ; overload;
    procedure DoInit(DrationLastShutdowm: longword); virtual;
    procedure DoInit2; virtual;
    procedure DoFinal; virtual;
    procedure DoFinal2; virtual;
    procedure DoDebug; virtual;
    procedure AddToIndexTable(Obj: TSerialObj);
    procedure DelFromIndexTable(Obj: TSerialObj);
    procedure ReqAAAQueryObj;
    procedure AddStoreFileToDC(FileName: CommonString);
    procedure RegTableCB(const id: TID_OBJ; TableName, StoreName: CommonString;
      TableType: TSerialObjClass; GetRecord: TGetRecord; GetRecords: TGetRecords;
      CanAddRecord: TCanAddRecord; CanDelRecord: TCanDelRecord; TableUpdated: TOnTableUpdated;
      RecordUpdated: TOnRecordUpdated; RecordDeled: TOnRecordDeled);
    procedure ChangeStatus(new: TMajorObjStatus);
    procedure ShowTopMsg(msg: CommonString);
    procedure DebugObj(const oid: TID_OBJ);
  public
    procedure Return; override;

    function IndependenceExecThread: boolean; virtual;
    function QueryHostParamValue(const id: TID_OBJ): CommonString; overload;
    function QueryHostParamValue(Name: CommonString): CommonString; overload;

    property BindExecThread: TExecThread read FBindExecThread write FBindExecThread;
    property ObjTree: TDataCenter read FObjTree;
    property AAAQuery: TAAAQueryProcObj read FAAAQuery;
    property MajorObjStatus: TMajorObjStatus read FMajorObjStatus;
    property ProcessedMsgCount: longword read FProcessedMsgCount;
    property UnHandledExceptCount: longword read FUnHandledExceptCount;
  end;

  TExecThread = class(TThread)
  private
    FInExecute: boolean;
    FTerminateWhenAllExec: boolean;
  protected
    procedure DoExec(m: TMsg);
    procedure Execute; override;
  public
    class function ClassID: longword; override;
    procedure AddMsg(itm: TMsg);
    property TerminateWhenAllExec: boolean read FTerminateWhenAllExec write FTerminateWhenAllExec;
  end;

  TExecThreadMng = class(TCriticalDDLLItem)
  private
    FRootObj: TObject;
    function GetIdleMsgCount: longword;
    function GetBusy: boolean;
  public
    procedure Reset; override;
    function NewExecThread: TExecThread;
    procedure StopAllWorkThread;

    property Busy: boolean read GetBusy;
    property IdleMsgCount: longword read GetIdleMsgCount;
    property RootObj: TObject read FRootObj write FRootObj;
  end;

  TOnProcRootMsg = procedure(Sender: TObject; msg: TMsg) of object;

  TObjRoot = class(TMajorObjBase)
  private
    FHostID: TID_HOST;
    FOnProcRootMsg: TOnProcRootMsg;
    FExecThreadMng: TExecThreadMng;
    FObjTree: TDataCenter;
    FNetQueryObj: TNetQueryObj;
    FWANObj: TMajorObjBase;
    FStartTime: longword;
    FTimerTick: longword;
    FRootStatus: longword;
    FRootError: ERRCODE;
    FSvrID: byte;
    FInStop: boolean;
    function GetSecond: Longword;
    function IsAllMajorStatusAfter(ms: TMajorObjStatus): boolean;
    procedure LoadHostID;
    procedure SaveHostID;
    procedure AssignMsgToMajor(msg: TMsg; mObj: TMajorObjBase; eObj: TObjBase);
    procedure AssignMsg(msg: TMsg);
    procedure NotifyUIRootStatus(const ui: TID_OBJ);
    procedure ShowTopMessage(msg: CommonString);
    procedure ExecThreadTerminate(thread: TThread);
    procedure ProcRecvNetQuery(msg: TMsg);
    procedure GlobalGbdOutput(DbgStr: CommonString; DbgLevel: longword);
    procedure MajorStatusChanged(mo: TMajorObjBase);
  protected
    function HostIsMe(const hid: TID_HOST): boolean; override;
    function DoGetHostID: TID_HOST; override;
    function DoProcessMsg(msg: TMsg): boolean; override;
  public
    class function ClassID: longword; override;
    procedure Reset; override;
    procedure Return; override;
    procedure SetProperty(PropertyName, PropertyValue: CommonString); override;

    function FindObjInTree(const ModuleID: TID_MODULE; LastRef: TObjBase = nil): TObjBase;
    function ExceptCount: longword;
    procedure MountConfigFile(FileName: CommonString);
    procedure SendSystemStartMsg(TickFromLastShutdown: longword);
    procedure SendSystemStopMsg;
    procedure SendSystemDebug;
    procedure SendTimerMsg(TickCount: longword);
    procedure StopAll(Reason: longword);
    procedure RegWANObj(Obj: TMajorObjBase);

    property HostID: TID_HOST read FHostID;
    property SvrID: byte read FSvrID;
    property WANObj: TMajorObjBase read FWANObj;
    property OnProcRootMsg: TOnProcRootMsg read FOnProcRootMsg write FOnProcRootMsg;
  end;

const
  LEVEL_ROOT_OBJ = 0;
  LEVEL_MAJOR_OBJ = 1;
  LEVEL_MINOR_OBJ = 2;

  PROPERTY_NAME_OBJIDX = 'objidx';

  OBJTYPE_NORMAL = 0;
  OBJTYPE_CONNECT_HOLDER = 1;
  OBJTYPE_NAME_NORMAL = 'normal';
  OBJTYPE_NAME_CONNECT_HOLDER = 'connect_holder';
  LOGID_ROOT_MODULE = LOGID_MODULE_MESSAGE + LOGID_MODULE_ROOT;
  LOGID_ROOT_REBOOT = LOGID_ROOT_MODULE + 1;
  LOGID_ROOT_SHUTDOWN = LOGID_ROOT_MODULE + 2;
  LOGID_ROOT_START = LOGID_ROOT_MODULE + 3;
  S_MSJORSTATUS: array [TMajorObjStatus] of CommonString =
    ('Idle', 'Init1', 'Normal', 'Error', 'Stoping', 'WaitFree', 'Stoped');

implementation

uses SysUtils, unitClassIDDef, unitCommonIntf, unitCommonMsgProc, unitTaskItem, unitMisc, unitErrCodeDef,
  unitSvrMngCommon, unitUniqueDataCommon, inifiles;

const
  S_PROPERTY_HOSTID = 'hostid';
  S_REGPATH = 'Software\HawkSoft\HawkServer\';
  S_REGHOSTID = 'HostID';

  { TObjBase }

procedure TObjBase.SetHostParam(const ParamID: TID_OBJ; Value: CommonString);
var
  Tmp: TCommonNameValue;
begin
  Tmp := ObjPool.GetObj(TCommonNameValue, Self);
  Tmp.objid := ParamID;
  Tmp.Value := Value;
  AddRecord(ID_HOSTPARAMTABLE, Tmp);
end;

procedure TObjBase.AddHostFunc(const fID: TID_OBJ; fName, InitValue, Comment: CommonString; ValueType: TValueType);
var
  Tmp: TCommonNameValue;
  bt: TDataCenter;
begin
  if InheritsFrom(TMajorObjBase) then
    bt := TMajorObjBase(Self).FObjTree
  else if (Parent <> nil) and (Parent.InheritsFrom(TMajorObjBase)) then
    bt := TMajorObjBase(Parent).FObjTree
  else
    bt := nil;
  if (bt <> nil) and (bt.FindObjExcept(fID, CLASSID_PRIORITYINFO) = nil) then
  begin
    Tmp := ObjPool.GetObj(TCommonNameValue, Self);
    Tmp.objid := fID;
    Tmp.Name := fName;
    Tmp.ValueType := ValueType;
    Tmp.Value := InitValue;
    Tmp.Comment := Comment;
    Tmp.Creator := FullObjID;
    AddRecord(ID_HOSTPARAMTABLE, Tmp);
  end;
end;

procedure TObjBase.AddObj(Obj: TObjBase);
begin
  AppendItem(Obj);
end;

procedure TObjBase.AddRecord(const pntid: TID_OBJ; Obj: TSerialObj);
var
  m: TMsg;
  so: TStringObj;
begin
  m := GetAMsg;
  m.TargetObjID := OBJID_UNIQUEDATAMODULE;
  m.MsgID := MESID_UNIQUEDATA_ADDOBJ;
  so := m.AddIDObj(pntid);
  so.AddObj(Obj);
  SendMsg(m);
end;

procedure TObjBase.ClearPrioritys(const rid: TID_OBJ);
var
  m: TMsg;
  r: TStringObj;
begin
  m := GetAMsg;
  m.objid := rid;
  m.TargetObjID := OBJID_UNIQUEDATAMODULE;
  m.MsgID := MESID_UNIQUEDATA_CLEARPRIORITY;
  SendMsg(m);
end;

procedure TObjBase.InitPriority(const rid, accid: TID_OBJ; Comment: CommonString; Mask: longword);
var
  m: TMsg;
  r: TStringObj;
begin
  m := GetAMsg;
  m.objid := rid;
  m.TargetObjID := OBJID_UNIQUEDATAMODULE;
  m.MsgID := MESID_UNIQUEDATA_INITRESOURCE;
  r := ObjPool.GetObj(TStringObj, Self);
  r.objid := accid;
  r.Flag := Mask;
  r.Str := Comment;
  m.AddObj(r);
  SendMsg(m);
end;

procedure TObjBase.InitPriorityAllOpe(const rid, accid: TID_OBJ; Comment: CommonString);
begin
  InitPriority(rid, accid, Comment, MESID_OPERATOR_MASK);
end;

procedure TObjBase.InitPriorityLocalModule(const rid: TID_OBJ; Comment: CommonString);
begin
  InitPriority(rid, MASK_LOCALALLMODULE, Comment, MESID_OPERATOR_MASK);
end;

procedure TObjBase.InitResource(const rid, accmask: TID_OBJ; Flag: longword; Comment: CommonString);
var
  m: TMsg;
  so: TStringObj;
begin
  m := GetAMsg;
  m.objid := rid;
  m.Caption := Comment;
  m.TargetObjID := OBJID_UNIQUEDATAMODULE;
  m.MsgID := MESID_UNIQUEDATA_INITRESOURCE;
  so := ObjPool.GetObj(TStringObj, Self);
  so.objid := accmask;
  so.Caption := S_INIT;
  so.Flag := Flag;
  m.AddObj(so);
  SendMsg(m);
end;

procedure TObjBase.MajorBroadcast(const src: TID_OBJ; MsgID: longword; Param: TSerialObj);
var
  m: TMsg;
  mo: TMajorObjBase;
begin
  mo := TMajorObjBase(root.Item[0]);
  while mo <> nil do
  begin
    m := ObjPool.GetObj(TMsg, Self);
    m.TargetObjID := mo.FullObjID;
    m.SourceObjID := src;
    m.MsgID := MsgID;
    if Param <> nil then
      m.AddObj(Param.Clone);
    SendMsg(m);
    mo := TMajorObjBase(mo.Next);
  end;
  ObjPool.ReturnObj(Param, Self);
end;

procedure TObjBase.Dbg(Str: CommonString; DbgLvl: longword);
begin
  Dbg(Str, [], DbgLvl);
end;

procedure TObjBase.DelObj(Obj: TObjBase);
begin
  ObjPool.ReturnObj(Obj, Self);
end;

procedure TObjBase.DelPriority(const rid, accid: TID_OBJ);
begin

end;

procedure TObjBase.DelRecord(const objid: TID_OBJ);
var
  m: TMsg;
begin
  m := GetAMsg;
  m.TargetObjID := OBJID_UNIQUEDATAMODULE;
  m.MsgID := MESID_UNIQUEDATA_DELOBJ;
  m.AddIDObj(objid);
  SendMsg(m);
end;

procedure TObjBase.DoCorrectObjID(Obj: TObjBase; LastIdx, NewIdx: byte);
begin

end;

procedure TObjBase.DoDumpObj;
var
  s: CommonString;
begin
  inherited;
  DumpStr('  ObjID=%d:%d %s', [FullObjID.IDDetail.SvrMdl.ModuleID.MajorID, FullObjID.IDDetail.SvrMdl.ModuleID.MinorID, ClassName]);
end;

function TObjBase.DoGetHostID: TID_HOST;
begin
  Result.Empty;
end;

function TObjBase.DoProcessMsg(msg: TMsg): boolean;
begin
  // 返回 True 表示处理完毕
  Result := True;
  case msg.MsgID of
    MESID_AAA_USEREVENTNOTIFY:
      ProcUserNotify(msg);
  end;
end;

function TObjBase.FindObj(Idx: byte): TObjBase;
begin
  Result := TObjBase(Item[0]);
  while Result <> nil do
  begin
    if Result.FObjIdx = Idx then
      Break;
    Result := TObjBase(Result.Next);
  end;
end;

procedure TObjBase.FocusResource(const hid: TID_HOST; const rIDs: TObjIDArr);
var
  m: TMsg;
  i: integer;
begin
  if Length(rIDs) > 0 then
  begin
    m := GetAMsg;
    m.TargetObjID := MakeObjID(hid, UNIQUEDATAMODULE_ID);
    m.MsgID := MESID_UNIQUEDATA_FOCUSRESOURCE;
    for i := Low(rIDs) to High(rIDs) do
      m.AddIDObj(rIDs[i], '', nil, True);
    SendMsg(m);
  end;
end;

function TObjBase.GetAMsg(RequestMsg: TMsg = nil): TMsg;
begin
  Result := ObjPool.GetObj(TMsg, Self);
  if Result <> nil then
  begin
    Result.SourceObjID := FullObjID;
    if RequestMsg <> nil then
      Result.TargetObjID := RequestMsg.SourceObjID;
  end;
end;

function TObjBase.GetFullObjID: TID_OBJ;
begin
  Result.Empty;
  if Parent <> nil then
    Result.IDDetail.SvrMdl.HostID := TObjBase(root).DoGetHostID
  else
    Result.IDDetail.SvrMdl.HostID := DoGetHostID;
  Result.IDDetail.SvrMdl.ModuleID := ModuleID;
end;

function TObjBase.GetModuleID: TID_MODULE;
begin
  if Parent <> nil then
    Result := TObjBase(Parent).GetModuleID
  else
    Result.ModuleID := 0;
  case Level of
    LEVEL_MAJOR_OBJ:
      Result.MajorID := FObjIdx;
    LEVEL_MINOR_OBJ:
      Result.MinorID := FObjIdx;
  end;
end;

procedure TObjBase.GetObj(const hid: TID_HOST; const id: TID_OBJ; NeedSubObjs, FocusObjs: boolean);
var
  m: TMsg;
  so: TStringObj;
begin
  m := GetAMsg;
  m.TargetObjID := MakeObjID(hid, UNIQUEDATAMODULE_ID);
  m.MsgID := MESID_UNIQUEDATA_GETOBJ;
  so := m.AddIDObj(id);
  if NeedSubObjs then
    so.Flag := L_GETOBJFLAG_NEEDSUBOBJS;
  if FocusObjs then
    so.Flag := so.Flag or L_GETOBJFLAG_FOCUSOBJS;
  SendMsg(m);
end;

procedure TObjBase.GetRecord(const oid: TID_OBJ);
var
  m: TMsg;
begin
  m := GetAMsg;
  m.TargetObjID := OBJID_UNIQUEDATAMODULE;
  m.MsgID := MESID_UNIQUEDATA_GETOBJ;
  m.AddIDObj(oid);
  SendMsg(m);
end;

function TObjBase.HostIsMe(const hid: TID_HOST): boolean;
begin
  if Parent <> nil then
    Result := TObjBase(root).HostIsMe(hid)
  else
    Result := False;
end;

function TObjBase.LocalRootID: TID_OBJ;
begin
  Result := FullObjID;
  Result.IDDetail.SvrMdl.ModuleID.MajorID := 1;
end;

procedure TObjBase.NotifyRecordUpdated(rIDs: TObjIDArr);
var
  m: TMsg;
  i: integer;
begin
  m := GetAMsg;
  m.TargetObjID := OBJID_UNIQUEDATAMODULE;
  m.MsgID := MESID_UNIQUEDATA_RECORDUPDATED;
  for i := Low(rIDs) to High(rIDs) do
    m.AddIDObj(rIDs[i]);
  SendMsg(m);
end;

procedure TObjBase.NotifyFocus(const id: TID_OBJ; notifyMsg: TMsg);
var
  m: TMsg;
begin
  m := GetAMsg;
  m.objid := id;
  m.MsgID := MESID_UNIQUEDATA_FOCUSNOTIFY;
  m.TargetObjID := OBJID_UNIQUEDATAMODULE;
  m.AddObj(notifyMsg);
  SendMsg(m);
end;

function TObjBase.ObjRoot: TObjRoot;
begin
  Result := TObjRoot(root);
end;

procedure TObjBase.Dbg(FmtStr: CommonString; Param: array of const; DbgLvl: longword);
var
  s: CommonString;
begin
  s := '[' + ClassName + ']' + Format(FmtStr, Param);
  DbgPrint(s, DbgLvl);
  if not FOnlyLocalDbg then
    SetHostParam(ID_DBGOUTPUT, s);
  // mm := GetAMsg;
  // mm.ObjID := ID_DBGOUTPUTTBL;
  // mm.TargetObjID := OBJID_UNIQUEDATAMODULE;
  // mm.MsgID := MESID_UNIQUEDATA_RESOURCENOTIFY;
  // m := GetAMsg;
  // m.ObjID := ID_DBGOUTPUTTBL;
  // m.MsgID := MESID_UNIQUEDATA_RESP_ADDRECORD;
  // so := ObjPool.GetObj(TStringObj, Self);
  // so.ObjID := m.SourceObjID;
  // so.Caption := s;
  // so.Flag := DbgLvl;
  // m.AddObj(so);
  // mm.AddObj(m);
  // SendMsg(mm);
  // if not CommonIntf.DebugHost.IsEmpty and (CommonIntf.DebugMask and DbgLvl = DbgLvl) then
  // begin
  // Tmp := TDebugInfo(ObjPool.GetObj(TDebugInfo, Self));
  // if Tmp <> nil then
  // begin
  // Tmp.DateTime := Now;
  // Tmp.DebugLevel := DbgLvl;
  // Tmp.DebugStr := s;
  // SendMsgToObj(CommonIntf.DebugHost, MESID_ALL_DEBUGINFO, 0, Tmp);
  // end;
  // end;
end;

procedure TObjBase.ProcUserNotify(msg: TMsg);
var
  ue: TUserMngEventNotify;
begin
  ue := msg.Param(TUserMngEventNotify);
  if ue <> nil then
  begin
    case ue.Event of
      ueCreated:
        ;
      ueModifyed:
        ;
      ueDeleted:
        ;
      ueOnLine:
        ;
      ueOffLine:
        ;
    end;
  end;
end;

procedure TObjBase.Return;
begin
  FObjIdx := 0;
  inherited;
end;

procedure TObjBase.ReturnList(src: TMsg; mesID: longword; list: TSerialObj);
var
  m: TMsg;
  o: TSerialObj;
begin
  m := GetAMsg(src);
  if m <> nil then
  begin
    m.MsgID := mesID;
    o := list.Obj[0];
    while o <> nil do
    begin
      m.AddObj(o.Clone);
      o := TSerialObj(o.Next);
    end;
    SendMsg(m);
  end;
end;

procedure TObjBase.ReturnMsg2(src: TMsg; MsgID: longword; const tblid, pntid: TID_OBJ;
  params: array of TSerialObj; Data: longword; Err: ERRCODE);
var
  rm: TMsg;
  po: TSerialObj;
  i: integer;
begin
  rm := GetAMsg(src);
  rm.objid := tblid;
  rm.MsgID := MsgID;
  if pntid.IsEmpty then
    po := rm
  else
    po := rm.GetObjByID(pntid, TStringObj);
  for i := Low(params) to High(params) do
    po.AddObj(params[i]);
  rm.Data := Data;
  rm.Error := Err;
  SendMsg(rm);
end;

procedure TObjBase.ReturnMsg1(src: TMsg; MsgID: longword; Param: TSerialObj; Data: longword; Obj: TObject);
var
  m: TMsg;
begin
  m := GetAMsg(src);
  if m <> nil then
  begin
    m.MsgID := MsgID;
    m.Data := Data;
    m.ConnObj := Obj;
    m.AddObj(Param);
    SendMsg(m);
  end
  else
    ObjPool.ReturnObj(Param, Self);
end;

procedure TObjBase.ReturnMsg(src: TMsg; MsgID: longword; Param: TSerialObj = nil; Data: longword = 0;
  Err: longword = 0);
var
  m: TMsg;
begin
  m := GetAMsg(src);
  if m <> nil then
  begin
    m.MsgID := MsgID;
    m.Data := Data;
    m.Error := Err;
    {$IFDEF DEBUG}
    if m.Parent <> nil then
      Dbg('Except!!! Parent is %s', [m.Parent.ClassName]);
    {$ENDIF}
    m.AddObj(Param);
    SendMsg(m);
  end
  else
    ObjPool.ReturnObj(Param, Self);
end;

procedure TObjBase.SendMsgToObj(const Tgt: TID_OBJ; MsgID, Data: longword; Pram: TSerialObj; Err: longword);
var
  m: TMsg;
begin
  m := GetAMsg;
  if m <> nil then
  begin
    m.TargetObjID := Tgt;
    m.MsgID := MsgID;
    m.Data := Data;
    m.Error := Err;
    m.AddObj(Pram);
    SendMsg(m);
  end;
end;

procedure TObjBase.SendLog(const UID: TID_OBJ; LogID, LogLevel: longword; Param: TCommStrArr);
var
  Tmp: TLogMsg;
begin
  Tmp := ObjPool.GetObj(TLogMsg, Self);
  if Tmp <> nil then
  begin
    Tmp.LogID := LogID;
    Tmp.LogLevel := LogLevel;
    Tmp.LogUserID := UID;
    Tmp.LogSource := FullObjID;
    Tmp.SetParStrs(Param);
    AddRecord(ID_CURLOGTABLE, Tmp);
  end;
end;

procedure TObjBase.SendMsg(m: TMsg);
begin
  if m <> nil then
    ObjRoot.AssignMsg(m);
end;

procedure TObjBase.SendMsgToObj(const Tgt: TID_OBJ; MsgID: longword; Prams: array of TSerialObj; Data, Err: longword);
var
  m: TMsg;
  i: integer;
begin
  m := GetAMsg;
  if m <> nil then
  begin
    m.TargetObjID := Tgt;
    m.MsgID := MsgID;
    m.Data := Data;
    m.Error := Err;
    for i := Low(Prams) to High(Prams) do
      m.AddObj(Prams[i]);
    SendMsg(m);
  end;
end;

procedure TObjBase.SetProperty(PropertyName, PropertyValue: CommonString);
var
  old: byte;
begin
  if PropertyName = PROPERTY_NAME_OBJIDX then
  begin
    old := FObjIdx;
    FObjIdx := StrToInt(PropertyValue);
    if Parent <> nil then
      TObjBase(Parent).DoCorrectObjID(Self, old, FObjIdx);
  end;
end;

procedure TObjBase.StartOrStopHostFunc(const hid: TID_HOST; const id: TID_OBJ; start: boolean);
var
  m: TMsg;
  so: TStringObj;
  nv: TCommonNameValue;
begin
  m := GetAMsg;
  m.TargetObjID := MakeObjID(hid, UNIQUEDATAMODULE_ID);
  m.MsgID := MESID_UNIQUEDATA_ADDOBJ;
  so := m.AddIDObj(ID_HOSTPARAMTABLE);
  nv := ObjPool.GetObj(TCommonNameValue, Self);
  nv.objid := id;
  if start then
    nv.Value := S_SWITCH_ON
  else
    nv.Value := S_SWITCH_OFF;
  so.AddObj(nv);
  SendMsg(m);
end;

procedure TObjBase.SendMsgToObj(const Tgt, objid: TID_OBJ; MsgID, Data: longword; Pram: TSerialObj; Err: longword);
var
  m: TMsg;
begin
  m := GetAMsg;
  m.TargetObjID := Tgt;
  m.MsgID := MsgID;
  m.objid := objid;
  m.Data := Data;
  m.Error := Err;
  m.AddObj(Pram);
  SendMsg(m);
end;

procedure TObjBase.SendMsgToSelf(MsgID: longword; const tblid, pntid: TID_OBJ; Prams: array of TSerialObj;
  Data, Err: longword);
var
  m: TMsg;
  i: integer;
  po: TSerialObj;
begin
  m := GetAMsg;
  m.TargetObjID := m.SourceObjID;
  m.MsgID := MsgID;
  m.objid := tblid;
  if pntid.IsEmpty then
    po := m
  else
    po := m.GetObjByID(pntid, TStringObj);
  for i := Low(Prams) to High(Prams) do
    po.AddObj(Prams[i]);
  SendMsg(m);
end;

{ TFastObjBase }

procedure TFastObjBase.AppendItem(DDLLI: TDoubleDirLinkListItem; Debug: boolean);
var
  Tmp: TObjBase absolute DDLLI;
  i: integer;
begin
  inherited;
  if Tmp.FObjIdx = 0 then
  begin
    for i := Low(FQuickObjIndex) to High(FQuickObjIndex) do
      if FQuickObjIndex[i] = nil then
      begin
        Tmp.FObjIdx := i;
        FQuickObjIndex[i] := Tmp;
        Break;
      end;
  end
  else if Tmp.FObjIdx <= High(FQuickObjIndex) then
    FQuickObjIndex[Tmp.FObjIdx] := Tmp;
end;

procedure TFastObjBase.ClearItems(FreeItem: boolean);
begin
  inherited;
  FillChar(FQuickObjIndex, SizeOf(FQuickObjIndex), 0);
end;

procedure TFastObjBase.DeleteItem(DDLLI: TDoubleDirLinkListItem; FreeItem, Debug: boolean);
var
  Obj: TObjBase ABSOLUTE DDLLI;
  Idx: integer;
begin
  Idx := Obj.FObjIdx;
  inherited;
  if (Idx >= Low(FQuickObjIndex)) and (Idx <= High(FQuickObjIndex)) then
    FQuickObjIndex[Idx] := nil;
end;

procedure TFastObjBase.DoCorrectObjID(Obj: TObjBase; LastIdx, NewIdx: byte);
begin
  if LastIdx <> NewIdx then
  begin
    FQuickObjIndex[LastIdx] := nil;
    FQuickObjIndex[NewIdx] := Obj;
  end;
end;

function TFastObjBase.FindObj(Idx: byte): TObjBase;
begin
  if Idx <= HIgh(FQuickObjIndex) then
    Result := FQuickObjIndex[Idx]
  else
    Result := nil;
end;

procedure TFastObjBase.Init;
begin
  FillChar(FQuickObjIndex, SizeOf(FQuickObjIndex), 0);
end;

procedure TFastObjBase.Return;
begin
  inherited;
  Init;
end;

procedure TMajorObjBase.AddToIndexTable(Obj: TSerialObj);
begin
  FObjTree.AddObjEntry(Obj);
end;

procedure TMajorObjBase.ChangeStatus(new: TMajorObjStatus);
begin
  if FMajorObjStatus <> new then
  begin
    FMajorObjStatus := new;
    if Parent <> nil then
      TObjRoot(Parent).MajorStatusChanged(Self);
  end;
end;

procedure TMajorObjBase.DebugObj(const oid: TID_OBJ);
var
  pia: TDDItemArr;
  i: integer;
  rf, ff: boolean;
begin
  pia := ObjTree.FindObj(oid);
  rf := False;
  ff := False;
  for i := Low(pia) to High(pia) do
    case pia[i].ClassID of
      CLASSID_PRIORITYINFO:
        rf := True;
      CLASSID_RESFOCUSINFO:
        ff := True;
      else
        Dbg('Debug Obj %s: class is %s ', [oid.ToString, pia[i].ClassName], L_DBGLEVEL_CRITICAL);
    end;
end;

procedure TMajorObjBase.DelFromIndexTable(Obj: TSerialObj);
begin
  FObjTree.DelObjEntry(Obj);
end;

procedure TMajorObjBase.DoDebug;
begin

end;

procedure TMajorObjBase.DoFinal;
begin
  ChangeStatus(mosStoping);
end;

procedure TMajorObjBase.DoFinal2;
begin
  ChangeStatus(mosWaitFree);
  Dbg('Module final complete');
end;

procedure TMajorObjBase.DoInit;
begin
  ChangeStatus(mosInit1);
end;

procedure TMajorObjBase.DoInit2;
begin
  ChangeStatus(mosNormal);
  Dbg('Module init complete');
end;

function TMajorObjBase.DoProcessMsg(msg: TMsg): boolean;
begin
  case msg.MsgID of
    MESID_AAA_SENDQUERYPROC:
    begin
      ObjPool.ReturnObj(FAAAQuery, Self);
      FAAAQuery := msg.Param(TAAAQueryProcObj);
      msg.DelObj(FAAAQuery);
      Result := True;
    end;
    else
      Result := inherited;
  end;
end;

procedure TMajorObjBase.ExecuteMsg(ExecObj: TObjBase; msg: TMsg);
begin
  Inc(FProcessedMsgCount);
  try
    case msg.MsgID of
      MSGID_ALL_START:
      begin
        DoInit(msg.Data);
        MessageProcessCompleted(msg);
      end;
      MSGID_ALL_START2:
      begin
        DoInit2;
        MessageProcessCompleted(msg);
      end;
      MSGID_ALL_STOP:
      begin
        DoFinal;
        MessageProcessCompleted(msg);
      end;
      MSGID_ALL_STOP2:
      begin
        DoFinal2;
        MessageProcessCompleted(msg);
      end;
      MSGID_ALL_DEBUG:
      begin
        DoDebug;
        MessageProcessCompleted(msg);
      end
      else
        if ExecObj.DoProcessMsg(msg) then
          MessageProcessCompleted(msg);
    end;
  except
    on E: Exception do
    begin
      Inc(FUnHandledExceptCount);
      MessageProcessCompleted(msg);
      Dbg('Obj %d(%s) Proc %x msg except: %s', [msg.TargetObjID.IDDetail.SvrMdl.ModuleID.MajorID,
        ClassName, NativeUInt(msg), E.Message], L_DBGLEVEL_CRITICAL);
      msg.Debug(2);
    end;
  end;
end;

{ TMajorObjBase }

procedure TMajorObjBase.AddStoreFileToDC(FileName: CommonString);
var
  m: TMsg;
begin
  if FileName <> '' then
  begin
    m := GetAMsg;
    m.TargetObjID := OBJID_UNIQUEDATAMODULE;
    m.MsgID := MESID_UNIQUEDATA_ADDSTOREFILE;
    m.AddIDObj(EMPTY_ID_OBJ, FileName);
    SendMsg(m);
  end;
end;

function TMajorObjBase.IndependenceExecThread: boolean;
begin
  Result := False;
  // 返回 True，将为此主对象和下级对象分配一个单独线程处理消息；否则将在通用线程中处理消息
end;

procedure TMajorObjBase.MessageProcessCompleted(msg: TMsg);
var
  Tmp: TID_OBJ;
begin
  Tmp := msg.TargetObjID;
  if (Level = LEVEL_MAJOR_OBJ) and (Tmp.IDDetail.SvrMdl.ModuleID.MajorID = $FF) then
    ObjRoot.AssignMsg(msg)
  else
    ObjPool.ReturnObj(msg, Self);
end;

function TMajorObjBase.QueryHostParamValue(Name: CommonString): CommonString;
var
  nvs: TStoreList;
  cnv: TCommonNameValue;
begin
  Result := '';
  if FObjTree <> nil then
  begin
    nvs := FObjTree.FindTable(ID_HOSTPARAMTABLE);
    if nvs <> nil then
    begin
      cnv := TCommonNameValue(nvs.FindItemLowerLevel(Name));
      if cnv <> nil then
        Result := cnv.Value;
    end;
  end;
end;

function TMajorObjBase.QueryHostParamValue(const id: TID_OBJ): CommonString;
var
  cnv: TCommonNameValue;
begin
  Result := '';
  if FObjTree <> nil then
  begin
    cnv := TCommonNameValue(FObjTree.FindObj(id, CLASSID_COMMON_NAMEVALUE));
    if cnv <> nil then
      Result := cnv.Value;
  end;
end;

procedure TMajorObjBase.RegTableCB(const id: TID_OBJ; TableName, StoreName: CommonString;
  TableType: TSerialObjClass; GetRecord: TGetRecord; GetRecords: TGetRecords; CanAddRecord: TCanAddRecord;
  CanDelRecord: TCanDelRecord; TableUpdated: TOnTableUpdated; RecordUpdated: TOnRecordUpdated;
  RecordDeled: TOnRecordDeled);
var
  m: TMsg;
  cb: TTableCallBack;
begin
  m := GetAMsg;
  m.TargetObjID := OBJID_UNIQUEDATAMODULE;
  m.MsgID := MESID_UNIQUEDATA_REGTABLECALLBACK;
  cb := ObjPool.GetObj(TTableCallBack, Self);
  cb.objid := id;
  cb.Caption := TableName;
  cb.StoreFileName := StoreName;
  cb.TableType := TableType;
  cb.GetRecord := GetRecord;
  cb.GetRecords := GetRecords;
  cb.CanAddRecord := CanAddRecord;
  cb.CanDelRecord := CanDelRecord;
  cb.TableUpdated := TableUpdated;
  cb.RecordUpdated := RecordUpdated;
  cb.RecordDeled := RecordDeled;
  m.AddObj(cb);
  SendMsg(m);
end;

procedure TMajorObjBase.ReqAAAQueryObj;
begin
  SendMsgToObj(OBJID_AUTHMODULE, MESID_AAA_GETQUERYPROC);
end;

procedure TMajorObjBase.Return;
begin
  inherited;
  ObjPool.ReturnObj(FAAAQuery, Self);
  FAAAQuery := nil;
  FBindExecThread := nil;
  FObjTree := nil;
  FProcessedMsgCount := 0;
  FUnHandledExceptCount := 0;
end;

procedure TMajorObjBase.ShowTopMsg(msg: CommonString);
var
  m: TMsg;
begin
  m := GetAMsg;
  m.MsgID := MESID_ALL_SHOWTOPMESSAGE;
  m.AddIDObj(EMPTY_ID_OBJ).Str := msg;
  SendMsg(m);
end;

function TMajorObjBase.UserIDOfSource(const eid: TID_OBJ): TID_OBJ;
begin
  if Assigned(FAAAQuery) then
  begin
    Result := FAAAQuery.QueryUserIDByHost(eid.IDDetail.SvrMdl.HostID);
    if Result.IsEmpty then
      Result := eid;
  end
  else
    Result := eid;
end;

function TMajorObjBase.UserIDOfSource(const msg: TMsg): TID_OBJ;
begin
  if Assigned(FAAAQuery) then
  begin
    Result := FAAAQuery.QueryUserIDByHost(msg.SourceObjID.IDDetail.SvrMdl.HostID);
    if Result.IsEmpty then
      Result := msg.SourceObjID;
  end
  else
    Result := msg.SourceObjID;
end;

procedure TExecThread.AddMsg(itm: TMsg);
begin
  AppendItem(itm);
  Resume;
end;

class function TExecThread.ClassID: longword;
begin
  Result := CLASSID_EXECTHREAD;
end;

procedure TExecThread.DoExec(m: TMsg);
var
  mObj: TMajorObjBase;
  ExecObj: TObjBase;
begin
  ExecObj := TObjBase(m.CurExecObj);
  if ExecObj <> nil then
  begin
    case ExecObj.Level of
      0, 1:
        mObj := TMajorObjBase(ExecObj);
      2:
        mObj := TMajorObjBase(ExecObj.Parent);
      else
        mObj := nil;
    end;
    FInExecute := True;
    DeleteItem(m, False);
    try
      if mObj <> nil then
        mObj.ExecuteMsg(ExecObj, m)
      else
        ObjPool.ReturnObj(m, Self);
    except
      on E: Exception do
      begin
        SendLog(ExecObj, LOGID_EXCEPT_EXEC_EXCEPT, LOG_LEVEL_EXCEPT,
          [E.Message, IntToHex(m.MsgID), m.SourceObjID.ToString, m.TargetObjID.ToString,
          IntToStr(m.Data), IntToStr(m.Count)]);
        DbgPrint('Except when %s process msg, Detail: %s', [ExecObj.ClassName, E.Message], L_DBGLEVEL_CRITICAL);
        DbgPrint('TMsg dump detail :', L_DBGLEVEL_CRITICAL);
        m.Debug(2);
      end;
    end;
    FInExecute := False;
  end
  else
    ObjPool.ReturnObj(m, Self);
end;

procedure TExecThread.Execute;
var
  m: TMsg;
begin
  while not Terminated do
  begin
    if Count > 0 then
    begin
      m := TMsg(Item[0]);
      DoExec(m);
    end
    else if FTerminateWhenAllExec then
      Break
    else
      Suspend;
  end;
end;

function TExecThreadMng.GetBusy: boolean;
var
  Tmp: TExecThread;
begin
  Result := False;
  Tmp := TExecThread(Item[0]);
  while Tmp <> nil do
  begin
    Result := Result or Tmp.FInExecute;
    if Result then
      Break;
    Tmp := TExecThread(Tmp.Next);
  end;
end;

function TExecThreadMng.GetIdleMsgCount: longword;
var
  Tmp: TExecThread;
begin
  Result := 0;
  Tmp := TExecThread(Item[0]);
  while Tmp <> nil do
  begin
    Inc(Result, Tmp.Count);
    Tmp := TExecThread(Tmp.Next);
  end;
end;

function TExecThreadMng.NewExecThread: TExecThread;
begin
  Result := TExecThread.Create('Message thread');
  AppendItem(Result);
end;

procedure TExecThreadMng.Reset;
var
  et: TExecThread;
begin
  inherited;
  if Created then
  begin
    et := TExecThread(ObjPool.GetObj(TExecThread, Self));
    AppendItem(et);
    et.Resume;
  end;
end;

procedure TExecThreadMng.StopAllWorkThread;
var
  et: TExecThread;
begin
  while Count > 0 do
  begin
    et := TExecThread(Item[0]);
    //et.FTerminateWhenAllExec := True;
    et.WaitForTerminate;
  end;
end;

{ TObjRoot }

procedure TObjRoot.AssignMsg(msg: TMsg);
var
  mObj: TMajorObjBase;
  tObj: TObjBase;

  procedure ReturnError(Param: TSerialObj; Err: ERRCODE);
  begin
    if msg.MsgID and MESID_RETURN = 0 then
      ReturnMsg(msg, msg.MsgID or MESID_RETURN, Param, 0, Err)
    else begin
//    Dbg('Enter ReturnError.ReturnObj msg = %x ErrCode = %d', [NativeUInt(msg), Err], L_DBGLEVEL_OUTPUT);
      ObjPool.ReturnObj(msg, Self);
//    Dbg('Leave ReturnError.ReturnObj', L_DBGLEVEL_OUTPUT);
    end;
  end;

begin
  if HostIsMe(msg.TargetObjID.IDDetail.SvrMdl.HostID) and (msg.TargetObjID.IDDetail.SvrMdl.Svr = 0) then
  begin
    if FInStop then
      ObjPool.ReturnObj(msg, Self)
    else if msg.TargetObjID.IDDetail.SvrMdl.ModuleID.MajorID = 0 then
    begin
      msg.CurExecObj := Self;
      FBindExecThread.AddMsg(msg);
    end
    else if msg.TargetObjID.IDDetail.SvrMdl.ModuleID.MajorID = $FF then
    begin
      if msg.CurExecObj = nil then
        mObj := TMajorObjBase(Item[0])
      else if msg.CurExecObj.Next <> nil then
        mObj := TMajorObjBase(msg.CurExecObj.Next)
      else
        mObj := nil;
      tObj := mObj;
      AssignMsgToMajor(msg, mObj, tObj);
    end
    else
    begin
      mObj := TMajorObjBase(FindObj(msg.TargetObjID.IDDetail.SvrMdl.ModuleID.MajorID));
      if mObj <> nil then
      begin
        if msg.TargetObjID.IDDetail.SvrMdl.ModuleID.MinorID = 0 then
          tObj := mObj
        else
          tObj := mObj.FindObj(msg.TargetObjID.IDDetail.SvrMdl.ModuleID.MinorID);
        if tObj <> nil then
          AssignMsgToMajor(msg, mObj, tObj)
        else
          ReturnError(msg, ERRCODE_OBJNOTEXIST);
      end
      else
        ReturnError(msg, ERRCODE_OBJNOTEXIST);
    end;
  end
  else if FWANObj <> nil then
  begin
    mObj := FWANObj;
    tObj := FWANObj;
    AssignMsgToMajor(msg, mObj, tObj);
  end
  else
    ReturnError(msg, ERRCODE_OBJNOTEXIST);
end;

procedure TObjRoot.AssignMsgToMajor(msg: TMsg; mObj: TMajorObjBase; eObj: TObjBase);
var
  t: TExecThread;
begin
  if mObj.FMajorObjStatus = mosWaitFree then
    ObjPool.ReturnObj(msg, Self)
  else
  begin
    if mObj.IndependenceExecThread then
    begin
      if mObj.FBindExecThread = nil then
      begin
        t := FExecThreadMng.NewExecThread;
        mObj.FBindExecThread := t;
      end
      else
        t := mObj.FBindExecThread;
    end
    else
      t := FBindExecThread;
    msg.CurExecObj := eObj;
    t.AddMsg(msg);
  end;
end;

class function TObjRoot.ClassID: longword;
begin
  Result := CLASSID_ROOT;
end;

function TObjRoot.DoGetHostID: TID_HOST;
begin
  Result := FHostID;
end;

function TObjRoot.DoProcessMsg(msg: TMsg): boolean;
var
  ui: TUserInfo;
  s: CommonString;
  Obj: TObjBase;
  rta: TRunTimeAccount;
begin
  Result := True;
  if msg <> nil then
    case msg.MsgID of
      MESID_ALL_ROOTSTATUSCHANGED:
      begin
        Dbg('Root status changed: %x(%x) peer: %s', [msg.Data, FRootStatus, msg.SourceObjID.ToString]);
        if FRootStatus <> msg.Data then
        begin
          FRootStatus := msg.Data;
          FRootError := msg.Error;
          ui := msg.Param(TUserInfo);
          NotifyUIRootStatus(MakeObjID(OBJTYPE_ENTITY, 255, FHostID, EMPTY_ID_MODULE));
          s := RouteStatusToStr(FRootStatus);
          if (FRootStatus and I_ROUTESTATUS_LOGINED <> 0) and Assigned(FNetQueryObj) then
          begin
            rta := FNetQueryObj.QueryRuntimeAccount(HOSTID_ROOT);
            if rta <> nil then
              if rta.FullName = '' then
                s := Format(s, [rta.Caption])
              else
                s := Format(s, [rta.FullName]);
          end;
          ShowTopMessage(s);
          Obj := TObjBase(Item[0]);
          while Obj <> nil do
          begin
            SendMsgToObj(Obj.FullObjID, MESID_ALL_ROOTSTATUSCHANGED, FRootStatus);
            Obj := TObjBase(Obj.Next);
          end;
        end;
      end;
      MESID_NET_UICONNECTED:
        NotifyUIRootStatus(msg.SourceObjID);
      MESID_NET_SENDQUERYOBJ:
        ProcRecvNetQuery(msg);
      else
        if Assigned(FOnProcRootMsg) then
          FOnProcRootMsg(Self, msg);
    end;
end;

function TObjRoot.ExceptCount: longword;
var
  Obj: TMajorObjBase;
begin
  Result := UnHandledExceptCount;
  Obj := TMajorObjBase(Item[0]);
  while Obj <> nil do
  begin
    Inc(Result, Obj.UnHandledExceptCount);
    Obj := TMajorObjBase(Obj.Next);
  end;
end;

procedure TObjRoot.ExecThreadTerminate(thread: TThread);
var
  ob: TMajorObjBase;
begin
  ob := TMajorObjBase(Item[0]);
  while ob <> nil do
  begin
    if ob.BindExecThread = thread then
      ob.BindExecThread := nil;
    ob := TMajorObjBase(ob.Next);
  end;
end;

function TObjRoot.FindObjInTree(const ModuleID: TID_MODULE; LastRef: TObjBase): TObjBase;
begin
  case ModuleID.MajorID of
    0:
      Result := Self;
    255:
      Result := nil;
    else
    begin
      Result := FindObj(ModuleID.MajorID);
      if Result <> nil then
        case ModuleID.MinorID of
          0:
            ;
          255:
            Result := nil;
          else
            Result := Result.FindObj(ModuleID.MinorID);
        end;
    end
  end;
end;

function TObjRoot.GetSecond: Longword;
var
  t: TDateTime;
begin
  t := EncodeDateTime(2000, 1, 1, 0, 0, 0, 0);
  Result := SecondsBetween(Now, t);
end;

procedure TObjRoot.GlobalGbdOutput(DbgStr: CommonString; DbgLevel: longword);
//var
//  so: TStringObj;
//  m, mm: TMsg;
begin
  // mm := GetAMsg;
  // mm.objid := ID_DBGOUTPUTTBL;
  // mm.TargetObjID := OBJID_UNIQUEDATAMODULE;
  // mm.MsgID := MESID_UNIQUEDATA_RESOURCENOTIFY;
  // m := GetAMsg;
  // m.objid := ID_DBGOUTPUTTBL;
  // m.MsgID := MESID_UNIQUEDATA_RESP_ADDOBJ;
  // so := ObjPool.GetObj(TStringObj, Self);
  // so.Caption := DbgStr;
  // so.Flag := DbgLevel;
  // m.AddObj(so);
  // mm.AddObj(m);
  // SendMsg(mm);
end;

function TObjRoot.HostIsMe(const hid: TID_HOST): boolean;
begin
  Result := (hid.IsEmpty or (hid = FHostID));
end;

function TObjRoot.IsAllMajorStatusAfter(ms: TMajorObjStatus): boolean;
var
  o: TMajorObjBase;
begin
  Result := True;
  o := TMajorObjBase(Item[0]);
  while o <> nil do
  begin
    if o.FMajorObjStatus < ms then
    begin
      Result := False;
      Break;
    end;
    o := TMajorObjBase(o.Next);
  end;
end;

procedure TObjRoot.LoadHostID;
var
  s: CommonString;
begin
  {$IFDEF MSWINDOWS}
  s := GetRegKeyValue(HKEY_LOCAL_MACHINE, S_REGPATH, S_REGHOSTID);
  FHostID.FromStr(s);
  {$ENDIF}
end;

procedure TObjRoot.MajorStatusChanged(mo: TMajorObjBase);
begin
  if IsAllMajorStatusAfter(mo.FMajorObjStatus) then
  begin
    FMajorObjStatus := mo.FMajorObjStatus;
    Dbg('Enter mode: %s', [S_MSJORSTATUS[FMajorObjStatus]]);
  end;
  case FMajorObjStatus of
    mosIdle:
      ;
    mosInit1:
      ;
    mosNormal:
      ;
    mosError:
      ;
    mosStoping:
      ;
    mosWaitFree:
    begin
      FExecThreadMng.StopAllWorkThread;
      FMajorObjStatus := mosStoped;
    end;
  end;
end;

procedure TObjRoot.MountConfigFile(FileName: CommonString);
type
  TConfigLineType = (cltNone, cltObj, cltProperty);
var
  Obj, Tmp: TObjBase;
  f: Text;
  s, sn, sv: CommonString;
  i: integer;
  clt: TConfigLineType;
begin
  ClearItems;
  s := FileName;
  Dbg('Read obj config file: %s', [s]);
  if FileExists(s) then
  begin
    AssignFile(f, s);
    try
      System.Reset(f);
      Readln(f, s);
      Obj := Self;
      while not EOF(f) do
      begin
        Readln(f, s);
        s := Trim(s);
        if (s <> '') and (s[1] <> '#') then
        begin
          clt := cltNone;
          i := Pos('=', s);
          if i <> 0 then
            clt := cltProperty
          else
          begin
            i := Pos(':', s);
            if i <> 0 then
              clt := cltObj;
          end;
          if i <> 0 then
          begin
            sn := LowerCase(Trim(Copy(s, 1, i - 1)));
            sv := Trim(Copy(s, i + 1, Length(s)));
          end;
          case clt of
            cltNone:
              if (s = 'end') and (Obj <> nil) then
                Obj := TObjBase(Obj.Parent);
            cltObj:
            begin
              Tmp := ObjPool.GetObj(sv, Self);
              if Tmp <> nil then
              begin
                Obj.AddObj(Tmp);
                Obj := Tmp;
              end
              else
                Dbg('Obj %s Can''t be FOUND ', [sv]);
            end;
            cltProperty:
              if Obj <> nil then
                Obj.SetProperty(sn, sv);
          end;
        end;
      end;
      CloseFile(f);
    except

    end;
  end;
  Obj := TObjBase(Item[0]);
  while Obj <> nil do
  begin
    TMajorObjBase(Obj).FObjTree := FObjTree;
    Obj := TObjBase(Obj.Next);
  end;
end;

procedure TObjRoot.NotifyUIRootStatus(const ui: TID_OBJ);
var
  m: TMsg;
begin
  if FWANObj <> nil then
  begin
    m := GetAMsg;
    m.TargetObjID := ui;
    m.Data := FRootStatus;
    m.MsgID := MESID_ALL_ROOTSTATUSCHANGED;
    SendMsg(m);
  end;
end;

procedure TObjRoot.ProcRecvNetQuery(msg: TMsg);
begin
  ObjPool.ReturnObj(FNetQueryObj, Self);
  FNetQueryObj := msg.Param(TNetQueryObj);
  msg.DelObj(FNetQueryObj);
end;

procedure TObjRoot.RegWANObj(Obj: TMajorObjBase);
begin
  FWANObj := Obj;
end;

procedure TObjRoot.Reset;
begin
  inherited;
  FStartTime := GetSecond;
  FTimerTick := FStartTime;
  if FExecThreadMng = nil then
    FExecThreadMng := TExecThreadMng.Create;
  BindExecThread := FExecThreadMng.NewExecThread;
  BindExecThread.OnTerminate := ExecThreadTerminate;
  if FObjTree = nil then
    FObjTree := TDataCenter.Create;
  FObjTree.SetExcludeClassIDs([CLASSID_SHAREFILESECOBJ, CLASSID_ACCESSCONTRLINFO]);
end;

procedure TObjRoot.Return;
begin
  inherited;
  FExecThreadMng.StopAllWorkThread;
  FExecThreadMng.Free;
  FExecThreadMng := nil;
  FreeAndNil(FObjTree);
end;

procedure TObjRoot.SaveHostID;
var
  s: CommonString;
begin
  s := FHostID.ToStr;
  CreateRegKeyValue(HKEY_LOCAL_MACHINE, S_REGPATH, S_REGHOSTID, s);
end;

procedure TObjRoot.SendSystemDebug;
var
  o: TObjBase;
  m: TMsg;
begin
  o := TObjBase(Item[0]);
  while o <> nil do
  begin
    m := GetAMsg;
    m.TargetObjID := o.FullObjID;
    m.MsgID := MSGID_ALL_DEBUG;
    AssignMsgToMajor(m, TMajorObjBase(o), o);
    o := TObjBase(o.Next);
  end;
end;

procedure TObjRoot.SendSystemStartMsg(TickFromLastShutdown: longword);
var
  o: TObjBase;
  m: TMsg;
  st: TCommonSysTime;
begin
  if FHostID.IsEmpty then
  begin
    LoadHostID;
    if FHostID.IsEmpty then
    begin
      FHostID.GeneralHostID;
      SaveHostID;
    end;
  end;
  o := TObjBase(Item[0]);
  while o <> nil do
  begin
    m := GetAMsg;
    if m <> nil then
    begin
      m.TargetObjID := o.FullObjID;
      m.MsgID := MSGID_ALL_START;
      m.Data := TickFromLastShutdown;
      AssignMsgToMajor(m, TMajorObjBase(o), o);
    end;
    o := TObjBase(o.Next);
  end;
  LoadLogStrFile(Self, 'all_log.txt');
  SendMsgToObj(OBJID_SVRMODULE, MESID_NET_GETQUERYOBJ);
end;

procedure TObjRoot.SendSystemStopMsg;
var
  o: TObjBase;
  m: TMsg;
begin
  FMajorObjStatus := mosStoping;
  o := TObjBase(Item[0]);
  while o <> nil do
  begin
    m := GetAMsg;
    m.TargetObjID := o.FullObjID;
    m.MsgID := MSGID_ALL_STOP;
    AssignMsgToMajor(m, TMajorObjBase(o), o);
    o := TObjBase(o.Next);
  end;
end;

procedure TObjRoot.SendTimerMsg(TickCount: longword);
var
  m: TMsg;
  ob: TMajorObjBase;
  ot: Longword;

  procedure SendTimerMsgToAllObj(MsgID: longword; Dbg: boolean);
  begin
    ob := TMajorObjBase(Item[0]);
    while ob <> nil do
    begin
      if (ob.FBindExecThread = nil) or (ob.FBindExecThread.Count < 10) then
      begin // 等待处理消息数量小于 10 个才给发时钟消息
        m := GetAMsg;
        m.TargetObjID := ob.FullObjID;
        m.MsgID := MsgID;
        m.Data := TickCount;
        AssignMsgToMajor(m, TMajorObjBase(ob), ob);
      end;
      ob := TMajorObjBase(ob.Next);
    end;
  end;

begin
  case FMajorObjStatus of
    mosIdle:
      ;
    mosInit1:
      if not FExecThreadMng.Busy then
      begin
        SendLog(OBJID_LOCAL, LOGID_ROOT_START, LOG_LEVEL_CRITICAL, []);
        ob := TMajorObjBase(Item[0]);
        while ob <> nil do
        begin
          m := GetAMsg;
          m.MsgID := MSGID_ALL_START2;
          AssignMsgToMajor(m, ob, ob);
          ob := TMajorObjBase(ob.Next);
        end;
      end;
    mosNormal:
    begin
      Inc(FTimerTick);
      TickCount := FTimerTick - FStartTime;
      SendTimerMsgToAllObj(MESID_ALL_TIMER, True);
      if TickCount mod (60 * 60) = 0 then
      begin
        SendTimerMsgToAllObj(MESID_ALL_HOURTIMER, False);
        Dbg('Send hour message');
      end;
      if FTimerTick mod (60 * 60 * 24) = 0 then
      begin
        SendTimerMsgToAllObj(MESID_ALL_ONTIMER_SAVECONFIG, False);
        ot := FTimerTick;
        FTimerTick := GetSecond;
        Dbg('Send day message, celibrate time: %d(%d)', [FTimerTick, ot]);
      end;
    end;
    mosError:
      ;
    mosStoping:
    begin
      ob := TMajorObjBase(Item[0]);
      while ob <> nil do
      begin
        if ob.MajorObjStatus = mosStoping then
        begin
          m := GetAMsg;
          m.MsgID := MSGID_ALL_STOP2;
          AssignMsgToMajor(m, ob, ob);
        end;
        ob := TMajorObjBase(ob.Next);
      end;
    end;
    mosWaitFree:
      ;
  end;
end;

procedure TObjRoot.SetProperty(PropertyName, PropertyValue: CommonString);
begin
  if PropertyName = S_PROPERTY_HOSTID then
    FHostID.FromStr(PropertyValue)
  else
    inherited;
end;

procedure TObjRoot.ShowTopMessage(msg: CommonString);
var
  m: TMsg;
begin
  m := GetAMsg;
  m.MsgID := MESID_ALL_SHOWTOPMESSAGE;
  m.Caption := msg;
  if Assigned(FOnProcRootMsg) then
    FOnProcRootMsg(Self, m);
  ObjPool.ReturnObj(m, Self);
end;

procedure TObjRoot.StopAll;
begin
  if not FInStop then
  begin
    SendLog(OBJID_LOCAL, LOGID_ROOT_SHUTDOWN, LOG_LEVEL_CRITICAL, [ErrCodeToStr(Reason)]);
    Dbg('Msg loop will stop!', L_DBGLEVEL_OUTPUT);
    SendSystemStopMsg;
    Dbg('Wait for all msg to exec: %d', [FExecThreadMng.IdleMsgCount], L_DBGLEVEL_OUTPUT);
    FInStop := True;
  end;
end;

initialization

  ObjPool.RegisterObjClass(TObjRoot);
  ObjPool.RegisterObjClass(TExecThread);

end.
